!
!     POMSUB       Auxiliary subroutines.
!     Copyright (C) 1997-9  Filip Hroch, Masaryk University, Brno, CZ
!                    
! ------------------------------------------------------------------------
!
subroutine getopt( opname, nopt, opt, omin, omax, istat)
!
! this procedure read optional parameters.
! open file 'opname' with user's optional values
! success => istat = 0 otherwise 1

  character(len=*) :: opname
  real :: opt(nopt),omin(nopt),omax(nopt)
  integer nopt, istat,i

  open(1,file=opname,status='old',iostat=istat)
  if( istat /= 0 )then
!     write(*,*) 'Parameters file not found. Using default values.'
     return
  else
     do i = 1,nopt
        read(1,"(tr28,f10.0)",err=99) opt(i)
        if( opt(i) < omin(i) .or. opt(i) > omax(i) )then
           istat = 1
           exit
        endif
     enddo
99   close(1)
  endif
  istat = 0
end

!
!-----------------------------------------------------------------------
!
!
!subroutine getap(apfile, nap, ap, pmin, pmax, istat )
!
! read file with aperture radii
!
!  character(len=*) :: apfile
!  integer :: nap,i,istat
!  real :: ap(nap),pmin(nap),pmax(nap)
!
!  open(1,file=apfile,status='old',iostat=istat)
!  if( istat /= 0 )then
!       write(*,*) 'Aperture file not found. Used default values.'
!     return
!  else
!     do i = 1,nap
!        read(1,"(tr28,f10.0)",err=99) ap(i)
!        if( ap(i) < pmin(i) .or. ap(i) > pmax(i) )then
!           istat = 1
!           exit
!        endif
!     enddo
!99   close(1)
!  end if
!end
!
!
! ---------------------------------------------------------------------
!
!      CHARACTER*1 FUNCTION UP( ZNAK )
!      CHARACTER*1 ZNAK
!C LOWER CHARACTER TO UPPER
!
!      IF( ZNAK.GE.'a'.AND.ZNAK.LE.'z' )THEN
!       UP = CHAR(ICHAR(ZNAK)-32)
!      ELSE
!       UP = ZNAK
!      ENDIF
!      END
!
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C
!      SUBROUTINE GETCOM(NUNIT, N, COM, MAX )
!C THIS PROCEDURE READ COMMANDS (LINES) FROM PREVIOUSLY OPENED
!C FILE ON NUNIT AND SAMPLING LINES ON SIMPLE STRINGS
!C
!      CHARACTER*80 COM(N),LINE
!      CHARACTER*1 UP
!      INTEGER N,ISTAT,I,M,NUNIT
!
!      N = 0
!      READ(NUNIT,'(A)',ERR=10,END=20) LINE
!      write(*,*) line
!      DO I=1,80
!        LINE(I:I) = UP(LINE(I:I))
!      ENDDO
!      M = 0
!      DO I=1,79
!        IF(LINE(I:I).EQ.' '.OR.LINE(I:I).EQ.',')THEN
!          IF( I-M.GT.1 )THEN
!            N = N+1
!            COM(N) = LINE(M+1:I-1)
!            IF( N.EQ.MAX ) RETURN
!          ENDIF
!          M = I
!        ENDIF
!      ENDDO
!10    DO I=N+1,MAX
!        COM(I) = ' '
!      ENDDO
!      RETURN
!20    N = -1
!      END
!C
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
!      SUBROUTINE GETPAR( PAR, DAT, N)
! GET PARAMETER FROM 'COMMAND' LINE OF COMMAND FILE
!
!      CHARACTER*80 PAR(*)
!      REAL DAT(*)
!      INTEGER I,IERR,N
!
!      DO I=1,N
!        READ(PAR(I),'(F80.0)',IOSTAT=IERR) DAT(I)
!        IF( IERR.NE.0 ) DAT(I) = -99999.9
!      ENDDO
!      END
!==============================================================================
!
!      SUBROUTINE INFILE (LUN, FILE, ISTAT)
!      IMPLICIT     NONE
!      INTEGER      LUN
!      CHARACTER*(*) FILE
!      INTEGER      ISTAT
!
!C      CHARACTER*100 EXPAND
!      OPEN (LUN, FILE=FILE, STATUS='OLD', ERR=999)
!      ISTAT = 0
!      RETURN
!  999 ISTAT = -1
!      RETURN
!      END
!
! ========================================================
!
      CHARACTER*(*) FUNCTION EXPAND(FILE)
      IMPLICIT     NONE
      CHARACTER*(*) FILE
      INTEGER I
      INTEGER J
      INTEGER K

      DO I=2,29
        IF (FILE(I:I) .EQ. ':') THEN
!*> delete command
!*            CALL GETENV (FILE(1:I-1), EXPAND)
          DO J=1,100
            IF (EXPAND(J:J) .NE. ' ') K=J
          END DO
          IF (K .NE. 0) THEN
            EXPAND = EXPAND(1:K)//'/'//FILE(I+1:30)
            RETURN
          END IF
        END IF
      END DO
      EXPAND = FILE
      RETURN
      END
!
!======================================================
!
!      SUBROUTINE OUTFIL (LUN, FILE, ISTAT)
!      IMPLICIT     NONE
!      INTEGER      LUN
!      CHARACTER*(*) FILE
!      INTEGER      ISTAT
!*> delete command      
!*      CHARACTER*30 ANSWER
!*      CHARACTER*100 EXPAND
!*      LOGICAL EXIST
!*
!* 1000 INQUIRE (FILE=EXPAND(FILE), EXIST=EXIST)
!*      IF (EXIST) THEN
!*         CALL STUPID ('This file already exists: '//FILE)
!*         ANSWER = 'OVERWRITE'
!*         CALL GETNAM ('NEW OUTPUT FILE NAME:', ANSWER)
!*         IF (ANSWER .EQ. 'OVERWRITE') THEN
!*            OPEN (LUN, FILE=EXPAND(FILE), STATUS='OLD')
!*            CLOSE (LUN, STATUS='DELETE')
!*         ELSE
!*            FILE = ANSWER
!*            GO TO 1000
!*         END IF
!*      END IF
!      OPEN (LUN, FILE=FILE, IOSTAT=ISTAT)
!      RETURN
!      END
